package WebPAC::Search::Estraier;

use warnings;
use strict;

use Search::Estraier;
use Encode qw/from_to/;
use Data::Dumper;

=head1 NAME

WebPAC::Search::Estraier - search Hyper Estraier full text index

=head1 VERSION

Version 0.07

=cut

our $VERSION = '0.07';

=head1 SYNOPSIS

Search WebPAC data using Hyper Estraier full text index created with
L<WebPAC::Output::Estraier>.

=head1 FUNCTIONS

=head2 new

Connect to Hyper Estraier index using HTTP

 my $est = new WebPAC::Search::Estraier(
 	masterurl => 'http://localhost:1978/',
	database => 'webpac2',
	user => 'admin',
	passwd => 'admin',
	encoding => 'iso-8859-2',
	log => $Log::Log4perl->log_object,
 );

Options are:

=over 4

=item maseterurl

URI to C<estmaster> node

=item database

name of C<estmaster> node

=item user

C<estmaster> user with read rights

=item passwd

password for user

=item encoding

character encoding of C<data_structure> if it's differenet than C<ISO-8859-2>
(and it probably is). This encoding will be converted to C<UTF-8> for
Hyper Estraier.

=item log

L<Log::Log4perl> object or equivalent (C<< $c->log >> can be used in
L<Catalyst> and there is support for it).

=back

=cut

sub new {
	my $class = shift;
        my $self = {@_};
        bless($self, $class);

	my $log = $self->_get_logger;

	foreach my $p (qw/masterurl user passwd/) {
		$log->logdie("need $p") unless ($self->{$p});
	}

	my $url = $self->{masterurl} . '/node/' . $self->{database};
	$self->{url} = $url;

	$log->info("opening Hyper Estraier index $self->{'url'} as $self->{'user'}");

	$self->{db} = Search::Estraier::Node->new;
	$self->{db}->set_url($self->{'url'});
	$self->{db}->set_auth($self->{'user'}, $self->{'passwd'});

	$self->{'encoding'} ||= 'ISO-8859-2';
	$log->info("using encoding ",$self->{encoding});

	$self ? return $self : return undef;
}


=head2 search

Locate items in index

  my @results = $est->search(
  	phrase => 'name of book or novel',
	add_attr => [
		"filepath ISTRINC $q",
		"size NUMGT 100",
	],
	get_attr => qw/PersonalName TitleProper/,
	order => 'NUMD',
	max => 100,
	options => $HyperEstraier::Condition::SURE,
	page => 42,
	depth => 0,
  );

Options are close match to Hyper Estraier API, except C<get_attr> which defines
attributes which will be returned in hash for each record.

Results are returned as hash array with keys named by attributes

Pages are numbered C< 1 ... hits/max >.

=cut

sub search {
	my $self = shift;

        my $args = {@_};

	my $log = $self->_get_logger;

	#$log->debug( 'search args: ' . Dumper($args) );

	$self->confess('need db in object') unless ($self->{db});
	$self->confess('need get_attr') unless ($args->{get_attr});

	$self->confess("need get_attr as array not " . ref($args->{get_attr}) ) unless (ref($args->{get_attr}) eq 'ARRAY');

	my $q = $args->{phrase};

	$log->debug("args: " . Dumper( $args ));

	my $cond = Search::Estraier::Condition->new();
	if ( ref($args->{add_attr}) eq 'ARRAY' ) {
		$log->debug("adding search attributes: " . join(", ", @{ $args->{add_attr} }) );
		map {
			$cond->add_attr( $self->convert( $_ ) );
			$log->debug(" + $_");
		} @{ $args->{add_attr} };
	};

	$cond->set_phrase( $self->convert($q) ) if ($q);
	$cond->set_options( $args->{options} ) if ($args->{options});
	$cond->set_order( $args->{order} ) if ($args->{order});

	my $max = $args->{max} || 7;
	my $page = $args->{page} || 1;
	if ($page < 1) {
		$log->warn("page number $page < 1");
		$page = 1;
	}

	$cond->set_max( $page * $max );

	my $result = $self->{db}->search($cond, ( $args->{depth} || 0 )) ||
		$log->logdie("can't search for ", sub { Dumper( $args ) });

	my $hits = $result->doc_num;
	$log->debug("found $hits hits for '$q'");

	my @results;

	for my $i ( (($page - 1) * $max) .. ( $hits - 1 ) ) {

		#$log->debug("get_doc($i)");
		my $doc = $result->get_doc( $i );
		if (! $doc) {
			$log->warn("can't find result $i");
			next;
		}

		my $hash;

		foreach my $attr (@{ $args->{get_attr} }) {
			my $val = $doc->attr( $attr );
			#$log->debug("attr $attr = ", $val || 'undef');
			$hash->{$attr} = $self->convert( $val ) if (defined($val));
		}

		if ($hash) {
			push @results, $hash;
		}

	}

#	$log->debug("results " . Dumper( \@results ));

	$self->confess("expected to return array") unless (wantarray);

	return @results;
}

=head2 confess

wrapper around L<Log::Log4perl> C<confess> or C<< $log->fatal >> or
C<< $log->error >> if they exists (like in L<Catalyst>), else plain
C<die>.

=cut

sub confess {
	my $self = shift;
	if (my $log = $self->{'log'}) {
		if ($log->can('logconfess')) {
			$log->logconfess(@_);
		} elsif ($log->can('fatal')) {
			$log->fatal(@_);
			die @_;
		} elsif ($log->can('error')) {
			$log->error(@_);
		} else {
			die @_;
		}
	} else {
		die @_;
	}
}

=head2 convert

convert internal encoding to UTF-8

  my $utf8 = $self->convert( $text );

=cut

sub convert {
	my $self = shift;

	my $text = shift || return;

	from_to($text, $self->{encoding}, 'UTF-8');
	return $text;
}


=head2 _get_logger

For compatibility with same method from L<WebPAC::Common>, but without
need for it.

=cut

sub _get_logger {
	my $self = shift;

	return $self->{'log'} || die "really need log!";
}

=head1 AUTHOR

Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>

=head1 COPYRIGHT & LICENSE

Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1; # End of WebPAC::Search::Estraier
